Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH6/SRC/HERMITE.FRM

Visual Basic Form | 1996-03-29 | 9.5 KB | 315 lines

VERSION 4.00
Begin VB.Form HermiteForm
   AutoRedraw      =   -1  'True
   Caption         =   "Hermite Curve"
   ClientHeight    =   5685
   ClientLeft      =   1650
   ClientTop       =   645
   ClientWidth     =   4830
   Height          =   6375
   Left            =   1590
   LinkTopic       =   "Form1"
   ScaleHeight     =   379
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   322
   Top             =   15
   Width           =   4950
   Begin VB.CheckBox ControlCheck
      Caption         =   "Draw Control Points"
      Height          =   255
      Left            =   1440
      TabIndex        =   12
      Top             =   60
      Value           =   1  'Checked
      Width           =   1815
   End
   Begin VB.CommandButton CmdGo
      Caption         =   "Go"
      Height          =   375
      Left            =   4320
      TabIndex        =   11
      Top             =   0
      Width           =   495
   End
   Begin VB.TextBox Vy2Text
      Height          =   285
      Left            =   4200
      TabIndex        =   9
      Text            =   "500"
      Top             =   480
      Width           =   615
   End
   Begin VB.TextBox Vx2Text
      Height          =   285
      Left            =   3120
      TabIndex        =   7
      Text            =   "-500"
      Top             =   480
      Width           =   615
   End
   Begin VB.TextBox Vy1Text
      Height          =   285
      Left            =   1440
      TabIndex        =   5
      Text            =   "-500"
      Top             =   480
      Width           =   615
   End
   Begin VB.TextBox Vx1Text
      Height          =   285
      Left            =   360
      TabIndex        =   3
      Text            =   "-500"
      Top             =   480
      Width           =   615
   End
   Begin VB.TextBox DtText
      Height          =   285
      Left            =   240
      TabIndex        =   2
      Text            =   "0.01"
      Top             =   45
      Width           =   615
   End
   Begin VB.PictureBox Canvas
      AutoRedraw      =   -1  'True
      Height          =   4815
      Left            =   0
      ScaleHeight     =   317
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   317
      TabIndex        =   0
      Top             =   840
      Width           =   4815
   End
   Begin VB.Label Label1
      Caption         =   "Vy2"
      Height          =   255
      Index           =   4
      Left            =   3840
      TabIndex        =   10
      Top             =   510
      Width           =   375
   End
   Begin VB.Label Label1
      Caption         =   "Vx2"
      Height          =   255
      Index           =   3
      Left            =   2760
      TabIndex        =   8
      Top             =   510
      Width           =   375
   End
   Begin VB.Label Label1
      Caption         =   "Vy1"
      Height          =   255
      Index           =   2
      Left            =   1080
      TabIndex        =   6
      Top             =   510
      Width           =   375
   End
   Begin VB.Label Label1
      Caption         =   "Vx1"
      Height          =   255
      Index           =   0
      Left            =   0
      TabIndex        =   4
      Top             =   510
      Width           =   375
   End
   Begin VB.Label Label1
      Caption         =   "dt"
      Height          =   255
      Index           =   1
      Left            =   0
      TabIndex        =   1
      Top             =   60
      Width           =   255
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
Attribute VB_Name = "HermiteForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Const PI = 3.14159
Const GAP = 3
' The endpoints.
Const NumPts = 2
Dim PtX(1 To NumPts) As Single
Dim PtY(1 To NumPts) As Single
' The index of the point being dragged.
Dim Dragging As Integer
Dim OldMode As Integer
' The hermite curve parameters.
Dim Ax As Single
Dim Bx As Single
Dim Cx As Single
Dim Dx As Single
Dim Ay As Single
Dim By As Single
Dim Cy As Single
Dim Dy As Single
' ************************************************
' Draw the curve on the indicated picture box.
' ************************************************
Sub DrawCurve(pic As PictureBox, start_t As Single, stop_t As Single, dt As Single)
Dim x1 As Single
Dim y1 As Single
Dim t As Single
    x1 = X(start_t)
    y1 = Y(start_t)
    pic.Cls
    pic.CurrentX = x1
    pic.CurrentY = y1
    t = start_t + dt
    Do While t < stop_t
        x1 = X(t)
        y1 = Y(t)
        pic.Line -(x1, y1)
        t = t + dt
    Loop
    x1 = X(stop_t)
    y1 = Y(stop_t)
    pic.Line -(x1, y1)
End Sub
' ************************************************
' Compute the Hermite curve parameters.
' ************************************************
Sub GetHermiteValues(ex1 As Single, ey1 As Single, ex2 As Single, ey2 As Single, vx1 As Single, vy1 As Single, vx2 As Single, vy2 As Single, Ax As Single, Bx As Single, Cx As Single, Dx As Single, Ay As Single, By As Single, Cy As Single, Dy As Single)
    Ax = vx2 + vx1 - 2 * ex2 + 2 * ex1
    Bx = 3 * ex2 - 2 * vx1 - 3 * ex1 - vx2
    Cx = vx1
    Dx = ex1
    Ay = vy2 + vy1 - 2 * ey2 + 2 * ey1
    By = 3 * ey2 - 2 * vy1 - 3 * ey1 - vy2
    Cy = vy1
    Dy = ey1
End Sub
' ************************************************
' The parametric function Y(t).
' ************************************************
Function Y(t As Single) As Single
    Y = Ay * t ^ 3 + By * t * t + Cy * t + Dy
End Function
' ************************************************
' The parametric function X(t).
' ************************************************
Function X(t As Single) As Single
    X = Ax * t ^ 3 + Bx * t * t + Cx * t + Dx
End Function
' ************************************************
' Prepare to draw the Hermite curve.
' ************************************************
Private Sub DrawHermite()
Const DOTTED = 2
Dim vx1 As Single
Dim vy1 As Single
Dim vx2 As Single
Dim vy2 As Single
Dim dt As Single
Dim i As Integer
    ' Compute the curve parameters.
    vx1 = CSng(Vx1Text.Text)
    vy1 = CSng(Vy1Text.Text)
    vx2 = CSng(Vx2Text.Text)
    vy2 = CSng(Vy2Text.Text)
    GetHermiteValues _
        PtX(1), PtY(1), PtX(2), PtY(2), _
        vx1, vy1, vx2, vy2, _
        Ax, Bx, Cx, Dx, Ay, By, Cy, Dy
    ' Draw the curve.
    dt = CSng(DtText.Text)
    DrawCurve Canvas, 0, 1, dt
    If ControlCheck.Value = vbChecked Then
        ' Draw the control points.
        For i = 1 To NumPts
            Canvas.Line _
                (PtX(i) - GAP, PtY(i) - GAP)- _
                Step(2 * GAP, 2 * GAP), , BF
        Next i

        ' Draw the tangents.
        OldMode = Canvas.DrawStyle
        Canvas.DrawStyle = DOTTED
        Canvas.Line (PtX(1), PtY(1))- _
            (PtX(1) + vx1 / 5, PtY(1) + vy1 / 5)
        Canvas.Line (PtX(2), PtY(2))- _
            (PtX(2) + vx2 / 5, PtY(2) + vy2 / 5)
        Canvas.DrawStyle = OldMode
    End If
End Sub
' ************************************************
' Select a point and start dragging it.
' ************************************************
Private Sub Canvas_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Integer
    ' Find a close point.
    For i = 1 To NumPts
        If Abs(PtX(i) - X) <= GAP And _
           Abs(PtY(i) - Y) <= GAP Then Exit For
    Next i
    If i > NumPts Then Exit Sub
    Dragging = i
    OldMode = Canvas.DrawMode
    Canvas.DrawMode = vbInvert
    PtX(Dragging) = X
    PtY(Dragging) = Y
    Canvas.Line _
        (PtX(Dragging) - GAP, PtY(Dragging) - GAP)- _
        Step(2 * GAP, 2 * GAP), , BF
End Sub
' ************************************************
' Continue dragging a point.
' ************************************************
Private Sub Canvas_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Dragging < 1 Then Exit Sub
    Canvas.Line _
        (PtX(Dragging) - GAP, PtY(Dragging) - GAP)- _
        Step(2 * GAP, 2 * GAP), , BF
    PtX(Dragging) = X
    PtY(Dragging) = Y
    Canvas.Line _
        (PtX(Dragging) - GAP, PtY(Dragging) - GAP)- _
        Step(2 * GAP, 2 * GAP), , BF
End Sub
' ************************************************
' Finish the drag and redraw the curve.
' ************************************************
Private Sub Canvas_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Dragging < 1 Then Exit Sub
    Canvas.DrawMode = OldMode
    PtX(Dragging) = X
    PtY(Dragging) = Y
    Dragging = 0
    DrawHermite
End Sub
Private Sub CmdGo_Click()
    DrawHermite
End Sub
Private Sub ControlCheck_Click()
    DrawHermite
End Sub
Private Sub Form_Load()
    PtX(1) = 0.5 * Canvas.ScaleWidth
    PtX(2) = 0.8 * Canvas.ScaleWidth
    PtY(1) = 0.7 * Canvas.ScaleHeight
    PtY(2) = 0.5 * Canvas.ScaleHeight
End Sub
' ************************************************
' Make the canvas as big as possible.
' ************************************************
Private Sub Form_Resize()
    Canvas.Move 0, Canvas.Top, _
        ScaleWidth, ScaleHeight - Canvas.Top
    DrawHermite
End Sub
Private Sub mnuFileExit_Click()
    Unload Me
End Sub